#reticulate::use_python("/anaconda3/bin/python")
library(readr)
library(ggplot2)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(methods)
library(stringi)
library(keras)

The dataset we will be using is ImageWoof. We are going to try and differentiate different dog breeds from one another.

Let’s read in the dataset we want to use! The CSV file is the metadata and the RDS file is the image data.

dogs <- read_csv("my-image-data.csv")

## Parsed with column specification:
## cols(
##   obs_id = col_character(),
##   train_id = col_character(),
##   class = col_double(),
##   class_name = col_character(),
##   path_to_image = col_character()
## )

x28 <- read_rds("my-image-embed.rds")
dogs

## # A tibble: 12,954 x 5
##    obs_id   train_id class class_name path_to_image                        
##    <chr>    <chr>    <dbl> <chr>      <chr>                                
##  1 id_0000… train        2 n02088364  ~/Desktop/imagewoof-320/train/n02088…
##  2 id_0000… train        3 n02089973  ~/Desktop/imagewoof-320/train/n02089…
##  3 id_0000… train        5 n02096294  ~/Desktop/imagewoof-320/train/n02096…
##  4 id_0000… valid        9 n02115641  ~/Desktop/imagewoof-320/train/n02115…
##  5 id_0000… train        1 n02087394  ~/Desktop/imagewoof-320/train/n02087…
##  6 id_0000… valid        9 n02115641  ~/Desktop/imagewoof-320/train/n02115…
##  7 id_0000… valid        9 n02115641  ~/Desktop/imagewoof-320/train/n02115…
##  8 id_0000… train        6 n02099601  ~/Desktop/imagewoof-320/train/n02099…
##  9 id_0000… train        6 n02099601  ~/Desktop/imagewoof-320/train/n02099…
## 10 id_0000… train        0 n02086240  ~/Desktop/imagewoof-320/train/n02086…
## # … with 12,944 more rows

Ok, nice! Now we will determine our variables. There are 10 dog breeds we are looking at: Australian terrier, Border terrier, Samoyed, Beagle, Shih-Tzu, English foxhound, Rhodesian ridgeback, Dingo, Golden retriever, Old English sheepdog. These correspond to the number of classes.

Let’s check out some of the classes and images we are working with.

x28 <- x28[dogs$class %in% 0:9,]
dogs <- dogs[dogs$class %in% 0:9,]
dognames <- dogs$class_name[match(0:9, dogs$class)]
dognames <- factor(dognames, levels = dognames)
dim(x28)

## [1] 12954  2048

One of the classes is the Dingo! Let’s see what that class looks like:

image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00000604.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)

Let’s check out a few more because they’re so cute!

image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00015821.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)

image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00012401.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)

image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00038762.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)

Now let’s start with the configuring our training sets.

X <- t(apply(x28, 1, cbind))
y <- dogs$class

X_train <- X[dogs$train_id == "train",]
y_train <- to_categorical(dogs$class[dogs$train_id == "train"])
dim(X_train)

## [1] 7772 2048

dim(y_train)

## [1] 7772   10

Great! It’s now time to use the model on the entire data set! First let’s start by using neural networks.

model <- keras_model_sequential()
model %>%
  layer_dense(units = 256, input_shape = ncol(X_train)) %>%
  layer_activation(activation = "relu") %>%
  layer_dropout(rate = 0.5) %>%

  layer_dense(units = 256) %>%
  layer_activation(activation = "relu") %>%
  layer_dropout(rate = 0.5) %>%

  layer_dense(units = ncol(y_train)) %>%
  layer_activation(activation = "softmax")

model %>% compile(loss = 'categorical_crossentropy',
                  optimizer = optimizer_rmsprop(lr = 0.001 / 2),
                  metrics = c('accuracy'))

history <- model %>%
  fit(X_train, y_train, epochs = 8)
plot(history)

Let’s see how well we did:

y_pred <- predict_classes(model, X)
tapply(y == y_pred, dogs$train_id, mean)

##     train     valid 
## 0.9801853 0.9359321

Not bad! 92% correct is pretty good. Let’s try and increase the number of epochs to increase our validation rate.

model <- keras_model_sequential()
model %>%
  layer_dense(units = 256, input_shape = ncol(X_train)) %>%
  layer_activation(activation = "relu") %>%
  layer_dropout(rate = 0.5) %>%

  layer_dense(units = 256) %>%
  layer_activation(activation = "relu") %>%
  layer_dropout(rate = 0.5) %>%

  layer_dense(units = ncol(y_train)) %>%
  layer_activation(activation = "softmax")

model %>% compile(loss = 'categorical_crossentropy',
                  optimizer = optimizer_rmsprop(lr = 0.001 / 2),
                  metrics = c('accuracy'))

history <- model %>%
  fit(X_train, y_train, epochs = 50)
plot(history)

Let’s see if we got any improvement:

y_pred <- predict_classes(model, X)
tapply(y == y_pred, dogs$train_id, mean)

##     train     valid 
## 0.9976840 0.9370899

There is slight improvement on the validation set, but it is not remarkebly different. Let’s look at some of the images that were misclassified.

id <- sample(which(y_pred != y), 20)[1:12]
par(mfrow = c(3, 4))
for (i in id) {
  par(mar = rep(0, 4L))
  plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE,type = "n", asp=1)
  Z <- image_load(dogs$path_to_image[i], target_size=c(224, 224))
  Z <- image_to_array(Z)
  rasterImage(Z /255,0,0,1,1)
  text(0.5, 0.1, label = dognames[y[i] + 1L], col = "red", cex=2)
}

Here we can see 12 of the dogs that were misclassifed. Since the breed names are not on there:

Photo #1:English Foxhound,
Photo #2: Old English Sheepdog,
Photo #3: Dingo,
Photo #4: Golden Retriever,
Photo #5: Australian Terrier,
Photo #6: Beagle,
Photo #7: Beagle,
Photo #8: Golden Retriever,
Photo #9: Beagle,
Photo #10: English Foxhound,
Photo #11: Australian Terrier, Photo #12: Border Terrier

Those are the breeds as predicted by the model.

Let’s now look at the dogs who fit their respective breeds the most!

y_probs <- predict(model, X)

# which are the maximum probs?
id <- apply(y_probs, 1, which.max)[1:12]

par(mfrow = c(3, 4))
for (i in id) {
  par(mar = rep(0, 4L))
  plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE,type = "n", asp=1)
  Z <- image_load(dogs$path_to_image[i], target_size=c(224, 224))
  Z <- image_to_array(Z)
  rasterImage(Z /255,0,0,1,1)
  text(0.5, 0.1, label = dognames[y[i] + 1L], col = "red", cex=2)
}

We have a few repeat images but nevertheless these are the prime examples of an Australian Terrier, Dingo, another Dingo, Shih Tzu, English Foxhound, another Dingo, and Beagle.

These are the dogs that have the highest probabilty of being the correct breed. A big componant of the breeds is coloring. This is why Beagles and English Foxhounds get confused.

pca <- as_tibble(prcomp(X)$x[,1:2])
pca$y <- dognames[y + 1L]
ggplot(pca, aes(PC1, PC2)) +
  geom_point(aes(color = y), alpha = 0.2, size = 7) +
  labs(x = "", y = "", color = "class") +
  theme_minimal()

*Overall, we have 93.6% correctness on determining the breed which is pretty good especially since you can see the heavy overlap in the different breeds.